open Glob
open Glob.Bin
module GT = Gtk_tools
module K = GdkKeysyms
open Gtk_helpers
module H = Histo

module Inc = struct
(*  type hist_info = Histo.hist * hist.show_opt*)
(*  type bins_region = All | Part of int*int*)
  type subpage = { 
      mutable plot_opt: Histo.plot_opt; 
      mutable hlist: Histo.hist list;
      mutable dhlist:  Histo.hist list;
      mutable show_opt_l: Histo.show_opt list; 
(*      mutable slice_info: (Histo.projection * bins_region) option*)
      mutable slice_info: (Histo.projection * float * float) option
  }
  let make_subpage () = { plot_opt = Histo.standard_plot;  
          hlist = []; dhlist = []; show_opt_l = []; slice_info = None }
  let clear_subpage sp = ( 
      sp.plot_opt <- Histo.standard_plot; sp.hlist <- []; 
      sp.dhlist <- []; sp.show_opt_l <- []; sp.slice_info <- None )
        
end

open Inc

class virtual window 
        ?(interactive=true) ?(is_main_window=true) window_title =
    let main_window_add, main_window_show =
    if is_main_window then (
      let main_window = GWindow.window 
        ~title:window_title ~border_width:2 () in
      ignore (main_window#connect#destroy ~callback:GMain.Main.quit);
      main_window#add, main_window#show
    ) else (
        let w = create_popup_window window_title in
        w#add, w#show
(*        let main_window = GWindow.dialog 
                ~title:window_title ~border_width:2 () in
        ignore (main_window#connect#close ~callback:main_window#misc#hide);
        main_window#add, main_window#show*)
    ) in
object(self)
    method main_window_show () = main_window_show ()
    val main_vbox = GPack.vbox () 
    val paned_window = GPack.paned `HORIZONTAL () 
    val vbox_controls = GPack.vbox () 
    val mutable current_plot_opt = H.standard_plot
    val mutable current_show_opt = H.standard_show

    initializer 
(*        main_window#add main_vbox#coerce;*)
        main_window_add main_vbox#coerce;
        self#make_upper_panel 
(*        (fun w -> main_vbox#pack ~expand:true ~fill:true w);*)
        (fun w -> main_vbox#pack w);
        main_vbox#pack ~expand:true ~fill:true paned_window#coerce;
        paned_window#add1 vbox_controls#coerce

    method pack w =
        vbox_controls#pack w

    method virtual draw_current_hist : ?show_errors:bool -> unit -> unit
    method draw_current_hist_e () = self#draw_current_hist ~show_errors:true ()
    method virtual save : ?color:bool -> string -> unit

    val mutex = Mutex.create ()
    method mutex = mutex
    method lock = Mutex.lock mutex
    method unlock = Mutex.unlock mutex

    val mutable advance_for_new = true
    val mutable nx_subpages = 1
    val mutable ny_subpages = 1
    method nx_ny = nx_subpages, ny_subpages
    val mutable hists_options = Matrix.init 1 1 (fun _ _ -> make_subpage ())
    val mutable hist_fits = Matrix.init 1 1 (fun _ _ -> make_subpage ())
    val mutable c_ix = 0
    val mutable c_iy = 0
(*    method current.dhlist = hists_options.(c_ix).(c_iy).dhlist*)
    method current = hists_options.(c_ix).(c_iy)
(*    method current_hlist = hists_options.(c_ix).(c_iy).hlist*)

    method dhlists_to_dhlists_by f =
        hists_options.(c_ix).(c_iy).dhlist <- 
            f hists_options.(c_ix).(c_iy).dhlist;
        hist_fits.(c_ix).(c_iy).dhlist <- 
            f hist_fits.(c_ix).(c_iy).dhlist;
        self#ia

    method hlists_to_dhlists_by f =
        hists_options.(c_ix).(c_iy).dhlist <- 
            f hists_options.(c_ix).(c_iy).hlist;
        hist_fits.(c_ix).(c_iy).dhlist <- 
            f hist_fits.(c_ix).(c_iy).hlist;
        self#ia

(*    method set_current.dhlist l =
        hists_options.(c_ix).(c_iy).dhlist <- l;
        self#ia
*)
    method virtual reinit_plotting: unit
    method layout nx ny =
        nx_subpages <- nx; ny_subpages <- ny;
        let create () = Matrix.init nx ny (fun _ _ -> make_subpage ()) in
        hists_options <- create ();
        hist_fits <- create ();
        c_ix <- 0; c_iy <- 0;
        self#reinit_plotting

    method ia = 
        if interactive then self#draw_current_hist ()

    method options_plot opt =
        hists_options.(c_ix).(c_iy).plot_opt <- opt;
        self#ia

    method options_show l =
        hists_options.(c_ix).(c_iy).show_opt_l <- l;
        self#ia

    method add_to page hlist =
        self#lock;
        page.(c_ix).(c_iy).hlist <- page.(c_ix).(c_iy).hlist @ hlist;
        let hl' = List.map (fun h -> self#apply_range h) hlist in
        page.(c_ix).(c_iy).dhlist <- page.(c_ix).(c_iy).dhlist @ hl';
        self#ia;
        self#unlock;
        ()

    method add_list hl =
        self#check_layout; if advance_for_new then self#advance; 
        let last_n = List.length self#current.show_opt_l in
        let add_n = List.length hl in
        let add_opt = List.map 
                (fun i -> {current_show_opt with H.color=last_n+i+1})
                (0 -- (add_n-1)) in
        self#current.show_opt_l <- self#current.show_opt_l @ add_opt;
        List.iter2 (fun h opt ->
            print_int opt.H.color;
            print_endline (H.name h);
        ) hl add_opt;
        self#add_to hists_options hl

(*    method add_list_options ?(plot_opt=H.standard_plot) hsl =*)
    method add_list_options ~plot_opt 
    (hsl: (Histo.hist * Histo.show_opt) list) =
        self#check_layout; if advance_for_new then self#advance; 
        self#current.plot_opt <- plot_opt;
        List.iter (fun (h,show_opt) ->
            self#current.hlist <- self#current.hlist @ [h];
            self#current.dhlist <- self#current.dhlist @ [self#apply_range h];
            self#current.show_opt_l <- self#current.show_opt_l @ [show_opt];
        ) hsl;
        self#ia

    method add_fix_list hol =
        self#check_layout; if advance_for_new then self#advance; 
        let last_n = List.length self#current.show_opt_l in
        let i = ref last_n in
        let h_o = List.fold_left (fun acc ho ->
            incr i;
            match ho with 
              | Some h ->
                      (h, {current_show_opt with H.color = !i}) :: acc
              | None -> acc
        ) [] hol in
        let hists, options_show = List.split (List.rev h_o) in
        self#current.show_opt_l <- self#current.show_opt_l @ options_show;
(*        List.iter2 (fun h opt ->
            print_int opt.H.color;
            print_endline (H.name h);
        ) hl add_opt;*)
        self#add_to hists_options hists

    method add h = 
        self#add_list [h]

    method add_fits hl =
        self#add_to hist_fits hl

    method add_fit h =
        self#add_fits [h]

    method set_fits_p hl ~origin =
        let show_opt_l = List.map 
                (fun p -> {p with H.plot1d=H.Polyline; })
                origin.show_opt_l in
        clear_subpage hist_fits.(c_ix).(c_iy);
        hist_fits.(c_ix).(c_iy).show_opt_l <- show_opt_l;
        self#add_to hist_fits hl

    val layout_entries =
        let e () = GEdit.entry ~text:"1" () in
        [| e (); e () |] 

    method check_layout =
        let n i = int_of_string layout_entries.(i)#text in
        let nx = n 0 and ny = n 1 in
        if self#nx_ny <> (nx,ny) then (
            self#layout nx ny;
            self#ia
        )

    method advance = 
        let nx, ny = self#nx_ny and x, y = c_ix, c_iy in
        let new_ix, new_iy = (
          if x=nx-1 && y=ny-1
          then 0,0
          else if x=nx-1
          then 0,y+1
          else x+1,y
        ) in
        c_ix <- new_ix; c_iy <- new_iy;
(*        Printf.printf "advance %i %i\n" c_ix c_iy; flush stdout;*)
        clear_subpage hists_options.(c_ix).(c_iy);
        hists_options.(c_ix).(c_iy).plot_opt <- current_plot_opt;
        clear_subpage hist_fits.(c_ix).(c_iy);
(*        Printf.printf "after len=%i\n" 
        (List.length hists_options.(c_ix).(c_iy).hlist); flush stdout;*)

    val fix_btn = GButton.check_button ~label:"Fix" ~active:false ()

    method apply_range ?(demand=false) h =
(*        Printf.printf "apply range dem=%b\n" demand; flush stdout;*)
        if demand || fix_btn#active then (
            let x,y = self#get_range in
(*            (match x with Some (x1,x2) ->
            Printf.printf "apply range %f %f\n" x1 x2; flush stdout);*)
            try (Histo.sub_hist ~x ~y h )
            with Histo.Invalid_histogram s -> 
                (self#complain ~message:s (); h)
        ) else h

    val range_entries = 
	let c0 =  [|0.;100.;0.;100.|] in
	Array.map (fun i -> 
            GEdit.entry ~text:(string_of_float c0.(i)) ())
          [| 0;1;2;3 |]

    method get_range =
            let c = Array.map 
                (fun e -> float_of_string e#text) 
                range_entries in
            let x = c.(0), c.(1) and y = c.(2), c.(3) in
            (Some x, Some y)

    method make_range pack =
        let hbox = GPack.hbox ~packing:pack () in
        hbox#pack fix_btn#coerce;
        self#tip fix_btn ("Select to use this range"^
                "for all next histogram views");
        Array.iter (fun e -> hbox#pack e#coerce) range_entries;
        let set_range () =
            self#hlists_to_dhlists_by 
                (List.map (self#apply_range ~demand:true))
        in
        Array.iter (fun e -> 
            ignore(e#connect#activate ~callback:set_range);
            e#misc#set_size_request ?width:(Some 45) ?height:(Some 25) ()
        ) range_entries;
        ()

    method make_rebin pack =
        let txt = [| "X"; "Y"; |] in
        let entries = Array.map (fun _ -> GEdit.entry ~text:"2" ()) txt in
        let do_rebin h = 
            let get_n e = ( try 
                Some (int_of_string e#text)
            with _ -> None ) in
            let n = Array.map get_n entries in
            H.rebin ~x:n.(0) ~y:n.(1) h
        in
        let on_demand () =
            self#dhlists_to_dhlists_by (List.map do_rebin) in
        let make_auto () =
            self#dhlists_to_dhlists_by (List.map (fun h -> H.rebin h)) in
        Array.iter (fun e -> 
            ignore(e#connect#activate ~callback:on_demand);
            e#misc#set_size_request ?width:(Some 45) ?height:(Some 25) ()
        ) entries;
        let widget = GT.hbox [] [
            GT.button "rebin" [`Pressed on_demand]; 
            GT.label txt.(0) []; entries.(0)#coerce;
            GT.label txt.(1) []; entries.(1)#coerce;
            GT.button "auto rebin" [`Pressed make_auto];
        ] in
        pack widget;
        ()

    method canvas_layout packing =
        let hbox = GPack.hbox ~packing () in
        ignore (GMisc.label ~text:"divide canvas" ~packing:hbox#pack ());
        Array.iteri (fun i entry -> 
            entry#misc#set_size_request ?width:(Some 25) ?height:(Some 25) ();
            let text = match i with 0 -> " x" | 1 -> " y" | _ -> "???" in
            ignore (GMisc.label ~text ~packing:hbox#pack ());
            hbox#pack entry#coerce;
            ignore (entry#connect#activate 
                ~callback:(fun () -> self#check_layout)
            ) 
        ) layout_entries

    method make_fitter =
        let perform_fit (text,f) = (
            let hl = List.map f self#current.dhlist in
            self#set_fits_p hl ~origin:self#current
        ) in
        let make_slice_fit (text,f) (proj,n) =
            let hl = List.map 
                (Fit_slices.fit_slices proj ~f ~n ~select:1)
                self#current.dhlist in
            self#set_fits_p hl ~origin:self#current
        in
        let common = make_hist_processing_frame "fit histograms"
                Perform.f_plot_list perform_fit Perform.f_list make_slice_fit in
        let window = create_popup_window "fit histograms" in
        window#add common;
        window#show
(*        pack (GT.button_popup_window "fit histograms" [] common)*)

    method make_proc2d =
        let perform_process (text,f) =
            Printf.printf "%s:\n" text;
            List.iter (fun h ->
                let v,e = f h in
                Printf.printf "    value=%f,error=%f\n" v e
            ) self#current.dhlist;
            flush stdout
        in
        let make_slice_process (text,f) (proj,n) =
                let hl = List.map 
                        (Process_slices.process_slices proj ~f ~n)
                        self#current.dhlist in
                self#add_list hl
        in
        let common = make_hist_processing_frame "process over bins"
                Process_slices.f_h_list perform_process 
                Process_slices.f_h_list make_slice_process in
        let efficiency_calculator =
            GT.button "efficiency" [`Pressed (fun () ->
                    List.iter Process_slices.print_efficiency
                    self#current.dhlist)] in

        let make_projection = GT.entry_button "make" "X" [
                `Activate (fun txt ->
                    self#dhlists_to_dhlists_by 
                    (List.map (fun h -> 
                        H.projection h (H.parse_projection txt)))
                )
        ] in
(*        let button = GT.button_popup_window "process histograms" []  *)
        let window = create_popup_window "process histograms" in
        window#add (GT.vbox [] [
            common; make_projection; efficiency_calculator]);
        window#show
(*        pack button*)

    method make_plot_options =
        let window = create_popup_window "Plot options" in
        let vbox=GPack.vbox ~packing:window#add () in
        self#canvas_layout vbox#pack;
        let set_plot_opt f options text =
            let opt = List.assoc text options in
(*            let popt = f opt hists_options.(c_ix).(c_iy).plot_opt in*)
            let popt = f opt current_plot_opt in
            hists_options.(c_ix).(c_iy).plot_opt <- popt;
            current_plot_opt <- popt;
            self#ia
        in
        let log_options = [ ("Log X", H.Log_X); ("Log Y", H.Log_Y); 
                ("Log Z", H.Log_Z) ] in
        let make_log = GT.hbox [] (
            List.map (fun (text,opt) -> 
                GT.check_button text 
                    [`Checked (fun _ -> 
                        set_plot_opt H.toggle_log log_options text)]
            ) log_options) in
        let grid_options = [ "Grid X",H.X; "Grid Y",H.Y; ] in
        let make_grid =GT.hbox [] (
            List.map (fun (text,opt) -> 
                GT.check_button text 
                    [`Checked (fun _ -> 
                        set_plot_opt H.toggle_grid grid_options text)]
            ) grid_options) in

        let set_show_opt f options text =
            let opt = List.assoc text options in
            current_show_opt <- f opt current_show_opt;
            hists_options.(c_ix).(c_iy).show_opt_l <- 
                List.map (f opt) hists_options.(c_ix).(c_iy).show_opt_l;
            self#ia
        in
        let make_radio_buttons f options =
            GT.radio_buttons `HORIZONTAL
                (List.map fst options) 
                [`Activate(set_show_opt f options)]
        in
        let plot1d_options = [ ("Lines", H.Lines); ("Polyline", H.Polyline);
                ("Bins", H.Columns); ("Err y", H.Err_y); 
                ("Line err", H.Line_err) ] in
        let make_plot1d = make_radio_buttons 
                (fun opt p -> {p with H.plot1d=opt}) plot1d_options in
        let plot2d_options = [ ("Box", H.Box); ("Color", H.Color);
                ("Gray", H.Grayscale); ("Contour", H.Contour); ] in
        let make_plot2d = make_radio_buttons
                (fun opt p -> {p with H.plot2d=opt}) plot2d_options in
        List.iter vbox#pack [make_log;make_grid;make_plot1d;make_plot2d];
        window#show

    method make_saver =
        let print () =
	      self#save "print.ps";
	      let error=Sys.command "lpr print.ps" in
		print_endline ("printed print.ps with error code"^
				 (string_of_int error))
        in
(*        let window_content = GT.hbox [] [
            GT.button "save" [`Pressed
        let button = GT.button_popup_window "Save histogram" 
        [] window_content in 
        packing button; ()*)
            
        let window = create_popup_window "Save histogram" in
        let hbox_print=GPack.hbox ~packing:window#add () in
        let print_button=GButton.button ~label:"print" 
                ~packing:hbox_print#pack () in
        let save_gray_button=GButton.button ~label:"save(gray)" 
                ~packing:hbox_print#pack () in
        let print_entry=GEdit.entry ~text:"print.pdf" (*~max_length:500*)
                ~packing:hbox_print#pack () in
        print_entry#connect#activate 
                ~callback:(fun () -> self#save ~color:true print_entry#text);
        save_gray_button#connect#clicked 
                ~callback:(fun () -> self#save ~color:false print_entry#text);
        let save_color_button=GButton.button ~label:"save(color)" 
                ~packing:hbox_print#pack () in
        save_color_button#connect#clicked 
                ~callback:(fun () -> self#save ~color:true print_entry#text);
        ignore (print_button#connect#clicked 
          ~callback:print);
        window#show

    method make_binop =
        let window = create_popup_window "binary opereations on histograms" in

        let reverse_order = ref false in
        let check = GT.check_button "reverse order" [
            `Checked (fun bool_v -> reverse_order := bool_v)] in

        let each_with_each f =
            let l = ref [] in
            let n = List.length self#current.dhlist in
            for i1 = 0 to n-1 do
                for i2 = 0 to n-1 do
                    let cond = if not !reverse_order then (<) else (>) in
                    if cond i1 i2 then (
                        let h1 = List.nth self#current.dhlist i1 in
                        let h2 = List.nth self#current.dhlist i2 in
                        let show_opt = List.nth self#current.show_opt_l i1 in
                        let new_elt = f h1 h2, show_opt in
                        l := new_elt :: !l
                    )
                done
            done;
            let dhlist, show_opt_l = List.split !l in
            self#current.dhlist <- dhlist;
            self#current.show_opt_l <- show_opt_l;
            self#ia
        in
        let make_binop name f =
            GT.button name [`Pressed (fun () -> each_with_each f)] in
        (*
        let div = (
            GT.entry_list_button "divide" [ "1."; "1." ] [
                `Activate (function
                    [txt1;txt2] ->
                        let f = Histo.div 
                                ~c1:(Glob.scan_float txt1)
                                ~c2:(Glob.scan_float txt2) in
                        each_with_each f 
                  | _ -> failwith "n /= 2")
            ]
        ) in
*)
        let make_binop_c1c2 name 
        (func: ?c1:float -> ?c2:float -> H.hist -> H.hist -> H.hist) = (
            GT.entry_list_button name [ "1."; "1." ] [
                `Activate (function
                    [txt1;txt2] ->
                        let f = func
                                ~c1:(Glob.scan_float txt1)
                                ~c2:(Glob.scan_float txt2) in
                        each_with_each f 
                  | _ -> failwith "n /= 2")
            ]
        ) in

        let div = make_binop_c1c2 "divide" Histo.div in
        let plus = make_binop_c1c2 "plus" Histo.plus in
        let mult_const = (
            GT.entry_button "multiply constant" "1." [
                `Activate (function txt1 ->
                    let f h = H.mul_const h (Glob.scan_float txt1) in
                    self#dhlists_to_dhlists_by (List.map f)
                )]
        ) in
        let frame = GT.frame "each with each" (
            GT.vbox [] [
                check;
                plus;
                div;
                mult_const;
                make_binop "multiply" H.mul;
                make_binop "significance" 
                        (fun sign bg -> H.significance ~sign ~bg);
            ]
        ) in
        window#add frame;
        window#show

    method about_dialog parent () =
        let dialog =
            GWindow.about_dialog
                ~name:"OKAHEP monitor" 
                ~title:("OKAHEP, library & monitor, version "^
                        OKAHEP_config.version) 
                ~authors:OKAHEP_config.authors
                ~comments:"monitoring program, written in OCaml"
                ~license:(OKAHEP_config.license_text ())
                ~parent
                ~destroy_with_parent:true
                ~position:`CENTER_ON_PARENT
        ()
              in
              ignore(dialog#connect#close ~callback:dialog#misc#hide);
              ignore
              (dialog#connect#response
              ~callback:(fun _ -> dialog#show ()));
              ignore (dialog#run ())


(*        let about_dialog = ref (fun () -> raise Not_found) in
        let show_dialog () =
          ( try !about_dialog ()
            with Not_found ->
                let dialog = GWindow.about_dialog 
                ~name:"OKAHEP monitor" 
                ~title:("OKAHEP, library & monitor, version "^Glob.version) 
                ~authors:["Makarov A."]
                ~comments:"monitoring program, written in OCaml"
                ~license:(Lazy.force Glob.license_text)
                ~destroy_with_parent:true
                ~position:`CENTER_ON_PARENT
                () in
                dialog#event#connect#delete
                (fun _ -> dialog#misc#hide(); true);
                about_dialog := dialog#present ;
                dialog#show () 
          ) in
        show_dialog*)
(*        let w = GWindow.about_dialog ~name:"OKAHEP monitor" () in
        w#run ();
        w#misc#hide ();
        w#show*)

    method virtual start_see_slices: int -> Histo.projection -> unit

    method make_show_slices =
        let window = create_popup_window "binary opereations on histograms" in
        let w = GT.entry_list_button "show slices" ["10"; "x"] [
                `Activate (function | [n_str; proj_str] ->
                    let n = Glob.scan_int n_str and 
                    proj = H.parse_projection proj_str in
                    self#start_see_slices n proj)
        ] in
        window#add w;
        window#show

    method make_upper_panel pack =
        let hbox = GPack.hbox ~packing:pack () in
        let menubar = GMenu.menu_bar ~packing:hbox#pack () in
        let factory = new GMenu.factory menubar in
        let accel_group = factory#accel_group in
        let file_menu = factory#add_submenu "File" in
        let view_menu = factory#add_submenu "View" in
        let edit_menu = factory#add_submenu "Edit" in
        let help_menu = factory#add_submenu "Help" in
        let factory = new GMenu.factory file_menu ~accel_group in
        factory#add_item "Save picture..." ~key:K._S
                ~callback:self#make_saver;
        factory#add_separator ();
        factory#add_item "Quit" ~key:K._Q
                ~callback:GMain.Main.quit;
        let factory = new GMenu.factory view_menu ~accel_group in
        factory#add_item "Plot options..." ~key:K._G 
                ~callback:self#make_plot_options;
        factory#add_item "Show slices" 
                ~callback:self#make_show_slices;
(*        self#make_plot_options pack;*)
        let factory = new GMenu.factory edit_menu ~accel_group in
        factory#add_item "process histograms..." ~key:K._H
                ~callback:self#make_proc2d;
        factory#add_item "fit histograms..." ~key:K._F
                ~callback:self#make_fitter;
        factory#add_item "binary operations..." ~key:K._B
                ~callback:self#make_binop;
        self#make_range hbox#pack;
        self#make_rebin hbox#pack;
        ( match GWindow.toplevel menubar with 
           | Some top -> 
              top#add_accel_group accel_group;
              let factory = new GMenu.factory help_menu ~accel_group in
              ignore(factory#add_item "About" 
                ~callback:(self#about_dialog top));
           | None -> ()
        )

    method complain ?(from: #GObj.widget = vbox_controls#coerce) ~message () =
               ignore(
                   let message=GWindow.message_dialog ~message
                   ~message_type:`ERROR
		   ~buttons:GWindow.Buttons.close
		  (* ?parent:(GWindow.toplevel from) ~destroy_with_parent:true*)
		   () in
                   message#run ();
                   message#destroy ()
               ); 

    val tooltips = GData.tooltips ()
    method tip widget text = tooltips#set_tip widget#coerce ~text

end
